home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / comm / bbs / multadvn.lha / multi.bas < prev    next >
Encoding:
BASIC Source File  |  1991-06-14  |  7.9 KB  |  311 lines
  1. rem the following two lines are for the HiSoft Basic Compiler
  2. REM $EVENT on
  3. REM $OPTION a+,k50,e-,g-,n+,p-,o-,x-,l-,s-,u-,v-,w+,y+
  4.  
  5. 1 DEFLNG a-z:cr$=CHR$(13)+CHR$(10):de$=CHR$(8)+" "+CHR$(8)
  6.  
  7. ON ERROR GOTO Errors
  8.  
  9. '2 rtime$="30":uname$="SYSOP":id$="1":lev$="9":bd$="2400":ring$="0"
  10. '3 path$="dh1:metro/doorfiles1/door23/"
  11. '4 test$="YES"
  12.  
  13. 2 CLOSE#2:OPEN "I",#2,"RAM:USERDATA":LINE INPUT#2,rtime$:LINE INPUT#2,uname$
  14. 3 LINE INPUT#2,id$:LINE INPUT#2,lev$:LINE INPUT#2,bd$:LINE INPUT#2,ring$
  15. 4 LINE INPUT#2,path$:CLOSE#2
  16.  
  17. 5 rtime=VAL(rtime$):id=VAL(id$):lev=VAL(lev$):ring=VAL(ring$):GOSUB modem.o
  18. 6 ON TIMER(60) GOSUB t.dec
  19. 7 title$="Multi-Adventure Door v1.0   ID:"+STR$(id)+"  "+uname$+"  Lev:"+STR$(lev)
  20. 8 WINDOW 1,title$,(0,0)-(617,185),7,-1:WINDOW OUTPUT 1:TIMER ON
  21.  
  22. SetUp:
  23.   MaxG=40:MaxQ=100:MaxCh=9
  24.   DIM gname$(MaxG),ques$(MaxQ),ch$(MaxQ,MaxCh),res$(MaxQ,MaxCh)
  25.   o$=cr$+cr$+cr$+cr$+SPACE$(28)+"The Multi-Adventure Door"+cr$:GOSUB modem.out
  26.   o$=SPACE$(28)+"   By Mark D. Turner"+cr$:GOSUB modem.out
  27.   o$=SPACE$(28)+"    Copyright 1990"+cr$+cr$+cr$+cr$:GOSUB modem.out
  28.   GOSUB AnyKey
  29.  
  30. LoadGameNames:
  31.   flnm$=path$+"Menu.Dat"
  32. 100 OPEN "i",2,flnm$
  33.   MaxGame=0
  34.   WHILE EOF(2)<>-1
  35.     LINE INPUT #2,temp$
  36.     IF temp$<>"" THEN MaxGame=MaxGame+1:gname$(MaxGame)=temp$
  37.     IF MaxGame=MaxG THEN LoadGameNames2 
  38.   WEND
  39. LoadGameNames2:
  40. CLOSE 2
  41.  
  42. MainMenu:
  43.   o$=cr$+cr$+cr$+" THE ADVENTURES"+cr$+cr$:GOSUB modem.out
  44.   FOR ct=1 TO MaxGame
  45.     o$=STR$(ct)+". "+gname$(ct)+cr$:GOSUB modem.out
  46.   NEXT ct
  47.   o$=STR$(0)+". Quit"+cr$:GOSUB modem.out
  48.   o$=cr$:GOSUB modem.out
  49. MainMenu2:
  50.   GOSUB timecheck
  51.   o$=" Your choice: ":in=4:il=2:GOSUB modem
  52.   game$=in$:game=VAL(game$)
  53.   IF game<0 OR game>MaxGame THEN MainMenu2
  54.   IF game=0 THEN bye
  55.   again$="YES"
  56.   GOSUB Intro
  57.   GOSUB ReadData
  58. MainMenu3:
  59.   GOSUB MainLoop
  60.   IF again$="YES" THEN MainMenu3
  61. GOTO MainMenu
  62.  
  63. Intro:
  64.   o$=cr$+cr$+cr$:GOSUB modem.out
  65.   flnm$=path$+"Intro."+game$
  66. 200 OPEN "I",2,flnm$
  67.   WHILE EOF(2)<>-1
  68.    LINE INPUT #2,temp$
  69.    o$=temp$+cr$:GOSUB modem.out
  70.   WEND
  71.   CLOSE #2
  72. 299 'return here if no Intro file
  73. RETURN
  74.  
  75. ReadData:
  76.   o$=cr$+"Loading...":GOSUB modem.out
  77.   ERASE ques$,ch$,res$
  78.   DIM ques$(MaxQ),ch$(MaxQ,MaxCh),res$(MaxQ,MaxCh)
  79.   ques=0:ch=0:res=0
  80.   flnm$=path$+"Game."+game$
  81. 300 OPEN "i",2,flnm$
  82. ReadData2:
  83.   what$="":mark$=""
  84. ReadData3:
  85.   LINE INPUT #2,temp$
  86.   IF temp$="" THEN ReadData3
  87.   IF LEFT$(temp$,3)="\Q\" THEN what$="Q":ques=ques+1:ch=0:res=0
  88.   IF LEFT$(temp$,3)="\A\" THEN what$="A":ch=ch+1
  89.   IF LEFT$(temp$,3)="\N\" THEN what$="N":res=res+1
  90.   IF LEFT$(temp$,3)="\Y\" THEN what$="Y":res=res+1
  91.   IF LEFT$(temp$,3)="\W\" THEN what$="W":res=res+1
  92.   IF temp$="\END\" THEN ReadData4
  93.   IF what$="Q" OR what$="A" THEN temp$=RIGHT$(temp$,(LEN(temp$)-3))
  94.   IF what$="" THEN mark$=cr$:what$=last$
  95.   IF what$="Q" THEN ques$(ques)=ques$(ques)+mark$+temp$
  96.   IF what$="A" THEN ch$(ques,ch)=ch$(ques,ch)+mark$+temp$
  97.   IF what$="N" OR what$="Y" OR what$="W" THEN res$(ques,res)=res$(ques,res)+mark$+temp$
  98.   last$=what$
  99.   GOTO ReadData2
  100. ReadData4:
  101.   CLOSE #2
  102. RETURN
  103.  
  104. MainLoop:
  105.   FOR ct=1 TO ques
  106.     o$=cr$+cr$+cr$:GOSUB modem.out
  107.     temp$=ques$(ct):GOSUB SendLines
  108.     o$=cr$:GOSUB modem.out
  109.     FOR ct2=1 TO MaxCh
  110.       IF ch$(ct,ct2)="" THEN hich=ct2-1:GOTO MainLoop2
  111.       temp$=STR$(ct2)+". "+ch$(ct,ct2):what$="ANSWER":GOSUB SendLines
  112.     NEXT ct2
  113. MainLoop2:
  114.     o$=cr$:GOSUB modem.out
  115. MainLoop3:
  116.     o$="Your choice: ":in=0:il=1:GOSUB modem
  117.     ch=VAL(in$)
  118.     IF ch<1 OR ch>hich THEN MainLoop3
  119.     GOSUB CheckResults
  120.     IF again$<>"CONTINUE" THEN RETURN
  121.   NEXT ct
  122. RETURN
  123.  
  124. CheckResults:
  125.   again$=""
  126.   res$=MID$(res$(ct,ch),2,1)
  127.   reply$=RIGHT$(res$(ct,ch),(LEN(res$(ct,ch))-3))
  128.   o$=cr$:GOSUB modem.out
  129.   temp$=reply$:GOSUB SendLines
  130.   IF res$="N" THEN
  131.     GOSUB timecheck
  132.     o$=cr$+"This game is over!"+cr$:GOSUB modem.out
  133.     o$="Do you wish to try again (y/N)? "
  134.     in=3:il=1:yes=0
  135.     GOSUB modem
  136.     again$=in$
  137.     RETURN
  138.   END IF
  139.   IF res$="Y" THEN again$="CONTINUE":GOSUB AnyKey:RETURN
  140.  
  141. Winner:
  142.   flnm$=path$+"Winner."+game$
  143. 400 OPEN "i",2,flnm$
  144.   WHILE EOF(2)<>-1
  145.     LINE INPUT #2,temp$
  146.     o$=temp$+cr$:GOSUB modem.out
  147.   WEND
  148.   CLOSE 2
  149. 499 GOSUB AnyKey
  150.   again$="WINNER"
  151. RETURN
  152.  
  153. SendLines:
  154.   linect=0
  155. SendLines2:
  156.   IF what$="ANSWER" AND linect>0 THEN temp$="    "+temp$
  157.   pos1=INSTR(temp$,cr$)
  158.   IF pos1>0 THEN
  159.     temp2$=LEFT$(temp$,pos1-1)
  160.     temp$=RIGHT$(temp$,(LEN(temp$)-pos1-1))
  161.     o$=temp2$+cr$:GOSUB modem.out
  162.     linect=linect+1
  163.     GOTO SendLines2
  164.   END IF
  165.   o$=temp$+cr$:GOSUB modem.out
  166.   what$=""
  167. RETURN
  168.  
  169. AnyKey:
  170.   o$=cr$+"Press any key... ":in=0:il=1:GOSUB modem
  171.   o$=cr$:GOSUB modem.out
  172. RETURN
  173.  
  174. Errors:
  175.   IF ERL=100 AND ERR=53 THEN o$=flnm$+" is missing.  Sorry!"
  176.   IF ERL=200 AND ERR=53 THEN PRINT "No Intro file found, but that's okay.":RESUME 299
  177.   IF ERL=300 AND ERR=53 THEN o$=flnm$+" is missing.  Sorry!"
  178.   IF ERL=400 AND ERR=53 THEN PRINT "No Winner file found, but that's okay.":RESUME 499
  179.   o$="Error "+STR$(ERR)+" on line "+STR$(ERL)+".  SORRY!"
  180.   GOSUB modem.out
  181.   GOSUB AnyKey
  182.   GOTO bye
  183.  
  184. bye:
  185. TIMER OFF
  186. IF test$<>"YES" THEN
  187.   KILL "RAM:USERDATA"
  188.   WINDOW CLOSE 1
  189. END IF
  190. GOSUB modem.c:CLEAR:END
  191.  
  192. modem:
  193. GOSUB modem.out:GOSUB modem.in:RETURN
  194.  
  195. modem.out:
  196. IF icon=0 THEN
  197.  oo$=o$:lo=LEN(oo$)
  198.  FOR ih=1 TO lo
  199.   IF MID$(oo$,ih,1)=CHR$(13) THEN MID$(oo$,ih,1)=CHR$(32)
  200.  NEXT:PRINT oo$;:oo$=""
  201. END IF
  202. IF ring=1 AND no.out=0 THEN PRINT#1,o$;:o$=""
  203. IF (modout=1 OR cmdmenu=1 OR dismsg=1 OR chat=1) THEN GOSUB modem.in
  204. RETURN
  205. mod.out1:
  206. abort=1:RETURN
  207.  
  208. modem.in:
  209. idle=TIMER:key$="":in$="":a$="":mi$="":a=0:keyy=0:b=0
  210. WHILE keyy<>1
  211.  key$=INKEY$:IF key$<>"" THEN mod.in1
  212.  IF ring=1 THEN
  213.   cd=PEEKL(12570624&):cd=cd AND 8192
  214.   IF cd<>0 THEN bye
  215.   IF LOC(1) THEN a$=INPUT$(1,1):key$=a$
  216.  END IF
  217. mod.in1:
  218. IF key$=CHR$(19) THEN
  219.  pau$="":paused=TIMER
  220.  WHILE TIMER<paused+45
  221.   pau$=INKEY$
  222.   IF pau$<>"" THEN key$="":pau$="":GOTO mod.in1.1
  223.   IF ring=1 THEN
  224.    IF LOC(1) THEN key$="":pau$="":GOTO mod.in1.1
  225.   END IF
  226.  WEND
  227.  key$="":pau$=""
  228. END IF
  229. mod.in1.1:
  230. IF (modout=1 OR cmdmenu=1 OR dismsg=1 OR chat=1) AND key$="" THEN keyy=1
  231. IF modout=1 AND key$=CHR$(32) THEN mod.out1
  232. IF modout=1 AND key$<>CHR$(32) THEN keyy=1
  233. IF cmdmenu=1 AND key$<>"" THEN cmd=1
  234. IF dismsg=1 AND key$<>"" THEN cmd=1
  235. IF key$="" THEN mod.in2
  236. mod.in1.5:
  237. a=ASC(key$):b=LEN(in$)
  238. IF a=13 THEN mod.in1.6
  239. IF a=129 THEN bye
  240. IF (a=8 OR a=127) AND LEN(in$)>=1 THEN
  241.  in$=LEFT$(in$,b-1):b=b-1:o$=de$:GOSUB modem.out
  242. END IF
  243. IF b=il THEN mod.in2
  244. IF in=0 THEN
  245.  IF a>31 AND a<127 THEN
  246.   IF cmd=1 THEN cmdmenu=0:dismsg=0
  247.   key$=UCASE$(key$):o$=key$+cr$:GOSUB modem.out:in$=key$:keyy=1
  248.  END IF
  249. END IF
  250. mod.in1.6:
  251. IF in=1 AND a>31 AND a<127 THEN o$=key$:GOSUB modem.out:in$=in$+key$
  252. IF in=2 AND a>31 AND a<127 THEN
  253.  key$=UCASE$(key$):o$=key$:GOSUB modem.out:in$=in$+key$
  254. END IF
  255. IF in=3 THEN
  256.  IF a=13 AND yes=1 THEN o$="YES":GOSUB modem.out:in$="YES":keyy=1
  257.  IF a=13 AND yes=0 THEN o$="NO":GOSUB modem.out:in$="NO":keyy=1
  258.  IF a=89 OR a=121 THEN o$="YES"+cr$:GOSUB modem.out:in$="YES":keyy=1
  259.  IF a=78 OR a=110 THEN o$="NO"+cr$:GOSUB modem.out:in$="NO":keyy=1
  260. END IF
  261. IF in=4 AND a>47 AND a<58 THEN o$=key$:GOSUB modem.out:in$=in$+key$
  262.  
  263. IF a=13 THEN o$=cr$:GOSUB modem.out:keyy=1
  264. mod.in2:
  265. IF TIMER>idle+300 THEN
  266.  IF sysop=1 AND logon=0 AND TIMER>idle+600 THEN bye
  267.  IF lev>7 AND TIMER>idle+600 THEN bye
  268.  IF lev<8 THEN bye
  269. END IF
  270. mod.in2.0:
  271. WEND
  272.  
  273. IF ring=1 THEN
  274.  IF LOC(1) THEN mi$=INPUT$(LOF(1),1):mi$=""
  275. END IF
  276. mod.in2.1:
  277. RETURN
  278.  
  279. time1:
  280. t.t=FRE(""):time1$=TIME$:t.t=VAL(LEFT$(time1$,2))
  281. IF t.t>11 THEN a$=" PM"
  282. IF t.t<12 THEN a$=" AM"
  283. IF t.t=0 THEN t.t=12:time1$=RIGHT$(STR$(t.t),2)+RIGHT$(time1$,6):GOTO timeout
  284. IF t.t<10 THEN time1$=RIGHT$(STR$(t.t),1)+RIGHT$(time1$,6):GOTO timeout
  285. IF t.t>21 THEN
  286.  t.t=t.t-12:time1$=RIGHT$(STR$(t.t),2)+RIGHT$(time1$,6):GOTO timeout
  287. END IF
  288. IF t.t>12 THEN t.t=t.t-12:time1$=RIGHT$(STR$(t.t),1)+RIGHT$(time1$,6)
  289. timeout:
  290. time1$=time1$+a$+"  "+DATE$:RETURN
  291.  
  292. timecheck:
  293. GOSUB time1
  294. IF rtime<=0 THEN
  295.  o$=cr$+cr$+"Sorry, Time Limit Exceeded!":GOSUB modem.out:GOTO bye
  296. END IF
  297. RETURN
  298.  
  299. t.dec:
  300. rtime=rtime-1
  301. RETURN
  302.  
  303. delayy:
  304. pause=TIMER:WHILE TIMER<pause+tt:WEND:RETURN
  305.  
  306. modem.c:
  307. CLOSE#1:RETURN
  308.  
  309. modem.o:
  310. OPEN "COM1:"+bd$+",n,8,1" AS #1 LEN=2048:RETURN
  311.